#include "deviser.h"
#include "gc.h"
#include <stdlib.h>

ext_ref mark_applying;
ext_ref mark_eval_args;
ext_ref mark_evaled;
ext_ref mark_eval;

ext_ref lfunc;
ext_ref cfunc;
ext_ref quote_form;
ext_ref def_form;
ext_ref fn_form;
ext_ref if_form;
ext_ref set_form;

void init_eval() {
	mark_applying.ref = mk_symbol("applying", 8);
	mark_applying.next = &mark_eval_args;
	mark_eval_args.ref = mk_symbol("evaluating_args", 15);
	mark_eval_args.next = &mark_evaled;
	mark_evaled.ref = mk_symbol("evaluated", 9);
	mark_evaled.next = &mark_eval;
	mark_eval.ref = mk_symbol("evaluate", 8);
	mark_eval.next = &lfunc;

	lfunc.ref = mk_symbol("lfunc", 5);
	lfunc.next = &cfunc;
	cfunc.ref = mk_symbol("cfunc", 5);
	cfunc.next = &quote_form;
	quote_form.ref = mk_symbol("quote", 5);
	quote_form.next = &def_form;
	def_form.ref = mk_symbol("define", 6);
	def_form.next = &fn_form;
	fn_form.ref = mk_symbol("fn", 2);
	fn_form.next = &if_form;
	if_form.ref = mk_symbol("if", 2);
	if_form.next = &set_form;
	set_form.ref = mk_symbol("set!", 4);
	set_form.next = root_set;
	root_set = &mark_applying;
}
	
cell env_lookup(cell name, cell env) {
	env = cdr(&env);
	while(!nullp(&env)) {
		if(eeqp(name, caar(&env))) {
			env = car(&env);
			return cdr(&env);
		}
		env = cdr(&env);
	}
	printf("symbol lookup fell through on: ");
	lisp_print(name, stdout);
	printf("\n");
	exit((int)dvs_error("Symbol not in symbol table"));
	return 0;
}

void set_bang(cell name, cell value, cell env) {
	env = cdr(&env);
	while(!nullp(&env)) {
		if(eeqp(name, caar(&env))) {
			env = car(&env);
			set_cdr(env, value);
			return;
		}
		env = cdr(&env);
	}
	printf("set! lookup fell through on: ");
	lisp_print(name, stdout);
	printf("\n");
	exit((int)dvs_error("Symbol not in symbol table"));
}

cell mk_env() {
	return cons(mk_symbol("*env*", 5), mk_eol());
}

void add_to_env(cell env, cell sym, cell value) {
	ext_ref e;
	e.ref = env;
	e.next = root_set;

	ext_ref s;
	s.ref = sym;
	s.next = &e;
	
	ext_ref v;
	v.ref = value;
	v.next = &s;
	
	root_set = &v;

	s.ref = cons(s.ref, v.ref);
	set_cdr(env, cons(s.ref, cdr(&env)));
	root_set = e.next;
}

cell cp_env(cell env) {
	return cons(mk_symbol("*env*", 5), cdr(&env));
}

cell mk_cont(cell code, cell env) {
	return cons(code, cons(env, cons(mark_eval.ref, mk_eol())));
}

cell get_env_cont(cell cont) {
	return cadr(&cont);
}

cell get_mark_cont(cell cont) {
	return caddr(&cont);
}

cell get_next_statement_cont(cell cont) {
	return caar(&cont);
}

cell next_statement_cont(cell cont) {
	return cdar(&cont);
}

cell next_cont_link(cell cont) {
	return cdddr(&cont);
}

int cont_mark_check(cell cont, cell mark) {
	return eeqp(get_mark_cont(cont), mark);
}

ext_ref cont;
ext_ref refs[20];

cell add_to_cont(cell first, cell env, cell mark, cell cont) {
	ext_ref g1, g2, g3, g4;
	g1.next = &g2;
	g2.next = &g3;
	g3.next = &g4;
	g4.next = root_set;

	g1.ref = first;
	g2.ref = env;
	g3.ref = mark;
	g4.ref = cont;
	root_set = &g1;

//	fprintf(stderr, "first cons\n");
//	lisp_print(g2.ref, stderr); fprintf(stderr, "\n");
	g3.ref = cons(g3.ref, g4.ref);
//	fprintf(stderr, "second cons\n");
//	lisp_print(g2.ref, stderr); fprintf(stderr, "\n");
	g2.ref = cons(g2.ref, g3.ref);
//	fprintf(stderr, "third cons\n");
	g1.ref = cons(g1.ref, g2.ref);
	root_set = g4.next;
	return g1.ref;
}

int num_conts() {
	cell c = cont.ref;
	int num = 0;
	while(!nullp(&c)) {
		num++;
		c = next_cont_link(c);
	}
	return num;
}

cell collect_args(cell codelist) {
	refs[18].ref = codelist;
	refs[19].ref = mk_eol();
	while(!nullp(&refs[18].ref)) {
		refs[19].ref = cons(car(&refs[18].ref), refs[19].ref);
		refs[18].ref = cdr(&refs[18].ref);
	}

	return refs[19].ref;
}

void call_lfunc(cell f) {
	//f contains evaled function and args
	//cont contains current continuation
	//returns new continuation with the function applying
	refs[0].ref = f;
	refs[1].ref = car(&refs[0].ref); //cell func = car(&f);
	refs[2].ref = get_code(&refs[1].ref); //cell code = get_code(&func);
	refs[3].ref = car(&refs[2].ref); //cell params = car(&code);
	refs[4].ref = get_env(&refs[1].ref); //cell env = get_env(&func);
	refs[5].ref = cdr(&refs[0].ref); //cell args = cdr(&f);
	
	refs[4].ref = cp_env(refs[4].ref);
	while(!nullp(&refs[5].ref) && !nullp(&refs[3].ref)) {
		add_to_env(refs[4].ref, car(&refs[3].ref), car(&refs[5].ref));
		refs[3].ref = cdr(&refs[3].ref);
		refs[5].ref = cdr(&refs[5].ref);
	}
	
	if(!nullp(&refs[5].ref) || !nullp(&refs[3].ref)) {
		exit((int)dvs_error("number of args does not match number of params"));
	}
	
	cont.ref =  add_to_cont(cdr(&refs[2].ref), refs[4].ref, mark_applying.ref,
				next_cont_link(cont.ref));
}

void eval_next_arg(cell functype) {
//	cell calldata = car(&cont.ref);
//	cell codelist = car(&calldata);
//	cell arglist = cadr(&calldata);

//	fprintf(stderr, "=====eval_next_arg=====\nfunctype: ");
//	lisp_print(functype, stderr); fprintf(stderr, "\nincont: ");
//	lisp_print(cont.ref, stderr); fprintf(stderr, "\nMaking a list of: ");

	refs[0].ref = cdaar(&cont.ref);
	refs[1].ref = cadar(&cont.ref);
	refs[2].ref = functype;
//	lisp_print(refs[0].ref, stderr); fprintf(stderr, " ");
//	lisp_print(refs[1].ref, stderr); fprintf(stderr, " ");
//	lisp_print(refs[2].ref, stderr); fprintf(stderr, "\nHere's the list: ");
	refs[0].ref = add_to_cont(refs[0].ref, refs[1].ref, refs[2].ref, mk_eol());
//	lisp_print(refs[0].ref, stderr); fprintf(stderr, "\nAnd an env: ");
	refs[1].ref = get_env_cont(cont.ref);
//	lisp_print(refs[1].ref, stderr); fprintf(stderr, "\nRedoing the cont, part 1: ");
	refs[1].ref = add_to_cont(refs[0].ref, refs[1].ref, mark_eval_args.ref, 
				next_cont_link(cont.ref));
//	lisp_print(refs[1].ref, stderr); fprintf(stderr, "\nHere's the bad one: ");
	refs[0].ref = caaar(&cont.ref);
	refs[2].ref = get_env_cont(refs[1].ref);
//	lisp_print(refs[0].ref, stderr); fprintf(stderr, "\nAnd it's env: ");
//	lisp_print(refs[2].ref, stderr); fprintf(stderr, "\nAnd last the new cont: ");
//	fprintf(stderr, "problem pointers: %p %p\n", refs[0].ref, refs[2].ref);
//	if(forwardp(refs[2].ref)) fprintf(stderr, "Unforwarded pointers\n");
	cont.ref = add_to_cont(refs[0].ref, refs[2].ref, mark_eval.ref, refs[1].ref);
//	lisp_print(cont.ref, stderr); fprintf(stderr, "\n");
//	fprintf(stderr, "=============\n");
}

void skip_next_arg(cell functype) {
//	cell calldata = car(&cont.ref);
//	cell codelist = car(&calldata);
//	cell arglist = cadr(&calldata);

	refs[0].ref = functype;
	refs[1].ref = cons(caaar(&cont.ref), cadar(&cont.ref));
	refs[1].ref = add_to_cont(cdaar(&cont.ref), refs[1].ref, refs[0].ref, mk_eol());
	cont.ref = add_to_cont(refs[1].ref, get_env_cont(cont.ref),
				mark_eval_args.ref, next_cont_link(cont.ref));
}

void dispatch_function(cell functype) {
//	cell calldata = car(&cont.ref);
//	cell codelist = car(&calldata);
//	cell arglist = cadr(&calldata);

	refs[1].ref = functype;
	refs[0].ref = collect_args(cadar(&cont.ref));

	if(eqp(&refs[1].ref, &lfunc.ref)) {
		call_lfunc(refs[0].ref);
	} else if(eqp(&refs[1].ref, &cfunc.ref)) {
		cell func = car(&refs[0].ref);
		cell r = (*(get_cfunc(&func)))(cdr(&refs[0].ref));
		cont.ref = add_to_cont(r, get_env_cont(cont.ref),
				       mark_evaled.ref, next_cont_link(cont.ref));
	} else if(eqp(&refs[1].ref, &quote_form.ref)) {
		if(list_length(refs[0].ref) != 2) exit((int)dvs_error("quote only takes one argument"));
		cont.ref = add_to_cont(cadr(&refs[0].ref), get_env_cont(cont.ref), 
				       mark_evaled.ref, next_cont_link(cont.ref));
	} else if(eqp(&refs[1].ref, &def_form.ref)) {
		if(list_length(refs[0].ref) != 3) exit((int)dvs_error("define takes three arguments"));
		cell env = get_env_cont(cont.ref);
		add_to_env(env, cadr(&refs[0].ref), caddr(&refs[0].ref));
		cont.ref = next_cont_link(cont.ref);
		cont.ref = add_to_cont(cadr(&refs[0].ref), env, mark_evaled.ref, cont.ref);
	} else if(eqp(&refs[1].ref, &fn_form.ref)) {
		cell env = get_env_cont(cont.ref);
		refs[0].ref = cdr(&refs[0].ref);
		cell func = mk_lfunc(&env, &refs[0].ref);
		cont.ref = add_to_cont(func, env, mark_evaled.ref, next_cont_link(cont.ref));
	} else if(eqp(&refs[1].ref, &if_form.ref)) {
		if(list_length(refs[0].ref) != 4) exit((int)dvs_error("if takes 3 arguments"));
		cell t = cadr(&refs[0].ref);
		if(!falsep(&t)) {
			cont.ref = add_to_cont(caddr(&refs[0].ref), get_env_cont(cont.ref),
					       mark_eval.ref, next_cont_link(cont.ref));
		} else {
			cont.ref = add_to_cont(cadddr(&refs[0].ref), get_env_cont(cont.ref), 
					       mark_eval.ref, next_cont_link(cont.ref));
		}
	} else if(eqp(&refs[1].ref, &set_form.ref)) {
		if(list_length(refs[0].ref) != 3) exit((int)dvs_error("set! takes 2 arguments"));
		cell env = get_env_cont(cont.ref);
		set_bang(cadr(&refs[0].ref), caddr(&refs[0].ref), env);
		cont.ref = add_to_cont(cadr(&refs[0].ref), env, 
				       mark_evaled.ref, next_cont_link(cont.ref));
	}
}

void eval_args() {
	cell calldata = car(&cont.ref);
	cell codelist = car(&calldata);
	cell arglist = cadr(&calldata);
	cell functype = caddr(&calldata);

	if(!nullp(&arglist) && enullp(cdr(&arglist))) {
		cell carg = car(&arglist);
		if(lfuncp(&carg)) {
			functype = lfunc.ref;
		} else if(cfuncp(&carg)) {
			functype = cfunc.ref;
		} else if(eeqp(carg, quote_form.ref)) {
			functype = quote_form.ref;
		} else if(eeqp(carg, def_form.ref)) {
			functype = def_form.ref;
		} else if(eeqp(carg, fn_form.ref)) {
			functype = fn_form.ref;
		} else if(eeqp(carg, if_form.ref)) {
			functype = if_form.ref;
		} else if(eeqp(carg, set_form.ref)) {
			functype = set_form.ref;
		}
	}
			
	if(nullp(&arglist) && nullp(&codelist)) {
		exit((int)dvs_error("Cannot evaluate empty list"));
	} else if(nullp(&arglist)) {
		eval_next_arg(functype);
	} else if(nullp(&codelist)) {
		dispatch_function(functype);
	} else if(eqp(&functype, &cfunc.ref) || eqp(&functype, &lfunc.ref)) {
		eval_next_arg(functype);
	} else if(eqp(&functype, &quote_form.ref) || eqp(&functype, &fn_form.ref)) {
		skip_next_arg(functype);
	} else if(eqp(&functype, &def_form.ref) || eqp(&functype, &set_form.ref)) {
		int l = list_length(arglist);
		if(l == 1) skip_next_arg(functype);
		else if(l == 2) eval_next_arg(functype);
		else exit((int)dvs_error("Too many args to define or set!"));
	} else if(eqp(&functype, &if_form.ref)) {
		int l = list_length(arglist);
		if(l == 1) eval_next_arg(functype);
		else skip_next_arg(functype);
	}
}

cell eval(cell code, cell e) {
	int jiffies = 0;
	cont.ref = NULL;
	int i;
	for(i = 0; i < 19; i++) {
		refs[i].ref = NULL;
		refs[i].next = refs + i + 1;
	}
	refs[19].ref = NULL;
	refs[19].next = &cont;
	cont.next = root_set;
	root_set = refs;

	refs[0].ref = code;
	refs[1].ref = e;
	cont.ref = mk_cont(refs[0].ref, refs[1].ref);
	
	while(!(cont_mark_check(cont.ref, mark_evaled.ref) && enullp(next_cont_link(cont.ref)))) {
		jiffies++;
		if(jiffies % 10000 == 0) { 
			printf("jiffies: %i\n", jiffies);
		}
//		fprintf(stderr, "%i: ", jiffies);
//		lisp_print(cont.ref, stderr); fprintf(stderr, "\n");
		if(cont_mark_check(cont.ref, mark_eval_args.ref)) {
			eval_args();
		} else if(cont_mark_check(cont.ref, mark_applying.ref)) {
			refs[1].ref = get_next_statement_cont(cont.ref);
			refs[0].ref = cont.ref;
			cont.ref = add_to_cont(next_statement_cont(cont.ref), get_env_cont(cont.ref), 
					       mark_applying.ref, next_cont_link(cont.ref));
			if(enullp(car(&cont.ref))) {
				cont.ref = add_to_cont(refs[1].ref, get_env_cont(cont.ref), 
						       mark_eval.ref, next_cont_link(cont.ref));
			} else {
				cont.ref = add_to_cont(refs[1].ref, get_env_cont(cont.ref), 
						       mark_eval.ref, cont.ref);
			}
		} else if(cont_mark_check(cont.ref, mark_evaled.ref)) {
			if(cont_mark_check(next_cont_link(cont.ref), mark_eval_args.ref)) {
				cell calldata = ecar(next_cont_link(cont.ref));
				cell codelist = car(&calldata);
				cell arglist = cadr(&calldata);
				cell functype = caddr(&calldata);

				refs[0].ref = codelist;
				refs[2].ref = functype;
				refs[1].ref = cons(car(&cont.ref), arglist);
				refs[0].ref = add_to_cont(refs[0].ref, refs[1].ref, 
							  refs[2].ref, mk_eol());
				refs[1].ref = get_env_cont(cont.ref);
				cont.ref = add_to_cont(refs[0].ref,
						       refs[1].ref,
						       mark_eval_args.ref,
						       next_cont_link(next_cont_link(cont.ref)));
			} else if(cont_mark_check(next_cont_link(cont.ref), mark_applying.ref)) {
				cont.ref = next_cont_link(cont.ref);
			}
		} else if(cont_mark_check(cont.ref, mark_eval.ref)) {
			refs[0].ref = car(&cont.ref);
			if(listp(refs[0].ref)) {
				refs[0].ref = add_to_cont(refs[0].ref, mk_eol(), mk_eol(), mk_eol());
				cont.ref = add_to_cont(refs[0].ref, 
						       get_env_cont(cont.ref), mark_eval_args.ref, 
						       next_cont_link(cont.ref));
			} else if(numberp(&refs[0].ref)) {
				cont.ref = add_to_cont(refs[0].ref, get_env_cont(cont.ref),
						       mark_evaled.ref, next_cont_link(cont.ref));
			} else if(symbolp(&refs[0].ref)) {
				cont.ref = add_to_cont(env_lookup(refs[0].ref, get_env_cont(cont.ref)),
						       get_env_cont(cont.ref), mark_evaled.ref, 
						       next_cont_link(cont.ref));
			} else {
				exit((int)dvs_error("Cannot evaluate for some reason"));
			}
		}
	}
	root_set = cont.next;
	return car(&cont.ref);
}
